home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / AMOD095.ZIP / TXT3D.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-10-06  |  25.4 KB  |  789 lines
  1. unit txt3d;
  2. interface
  3. {$s-}
  4. const
  5.   scr_seg : word = $a000;
  6.  
  7. type
  8. t_matrix = array[0..8] of longint;
  9.  
  10. var
  11. matrix : t_matrix;
  12.  
  13. procedure matriisi(var mat : t_matrix;kx2,ky2,kz2 : integer);
  14. procedure rotatep;
  15. procedure line3(x1,y1,x2,y2 : integer;color : byte);
  16. procedure mix;
  17. procedure show;
  18. procedure hide;
  19. procedure setfont;
  20. procedure l3d_cube;
  21. procedure l3d_pyramid;
  22. procedure l3d_adnmod;
  23. procedure init3d;
  24.  
  25. implementation
  26. const
  27.   fontti_POINTS=$08;
  28.   fontti : ARRAY [1..$0800] OF CHAR = (
  29.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  30.     #$7E, #$81, #$A5, #$81, #$BD, #$99, #$81, #$7E, 
  31.     #$7E, #$FF, #$DB, #$FF, #$C3, #$E7, #$FF, #$7E, 
  32.     #$6C, #$FE, #$FE, #$FE, #$7C, #$38, #$10, #$00, 
  33.     #$10, #$38, #$7C, #$FE, #$7C, #$38, #$10, #$00, 
  34.     #$38, #$7C, #$38, #$FE, #$FE, #$7C, #$38, #$7C, 
  35.     #$10, #$10, #$38, #$7C, #$FE, #$7C, #$38, #$7C, 
  36.     #$00, #$00, #$18, #$3C, #$3C, #$18, #$00, #$00, 
  37.     #$FF, #$FF, #$E7, #$C3, #$C3, #$E7, #$FF, #$FF, 
  38.     #$00, #$3C, #$66, #$42, #$42, #$66, #$3C, #$00, 
  39.     #$FF, #$C3, #$99, #$BD, #$BD, #$99, #$C3, #$FF, 
  40.     #$0F, #$07, #$0F, #$7D, #$CC, #$CC, #$CC, #$78, 
  41.     #$3C, #$66, #$66, #$66, #$3C, #$18, #$7E, #$18, 
  42.     #$3F, #$33, #$3F, #$30, #$30, #$70, #$F0, #$E0, 
  43.     #$7F, #$63, #$7F, #$63, #$63, #$67, #$E6, #$C0, 
  44.     #$99, #$5A, #$3C, #$E7, #$E7, #$3C, #$5A, #$99, 
  45.     #$80, #$E0, #$F8, #$FE, #$F8, #$E0, #$80, #$00, 
  46.     #$02, #$0E, #$3E, #$FE, #$3E, #$0E, #$02, #$00, 
  47.     #$18, #$3C, #$7E, #$18, #$18, #$7E, #$3C, #$18, 
  48.     #$66, #$66, #$66, #$66, #$66, #$00, #$66, #$00, 
  49.     #$7F, #$DB, #$DB, #$7B, #$1B, #$1B, #$1B, #$00, 
  50.     #$3E, #$63, #$38, #$6C, #$6C, #$38, #$CC, #$78, 
  51.     #$00, #$00, #$00, #$00, #$7E, #$7E, #$7E, #$00, 
  52.     #$18, #$3C, #$7E, #$18, #$7E, #$3C, #$18, #$FF, 
  53.     #$18, #$3C, #$7E, #$18, #$18, #$18, #$18, #$00, 
  54.     #$18, #$18, #$18, #$18, #$7E, #$3C, #$18, #$00, 
  55.     #$00, #$18, #$0C, #$FE, #$0C, #$18, #$00, #$00, 
  56.     #$00, #$30, #$60, #$FE, #$60, #$30, #$00, #$00, 
  57.     #$00, #$00, #$C0, #$C0, #$C0, #$FE, #$00, #$00, 
  58.     #$00, #$24, #$66, #$FF, #$66, #$24, #$00, #$00, 
  59.     #$00, #$18, #$3C, #$7E, #$FF, #$FF, #$00, #$00, 
  60.     #$00, #$FF, #$FF, #$7E, #$3C, #$18, #$00, #$00, 
  61.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  62.     #$30, #$78, #$78, #$78, #$30, #$00, #$30, #$00, 
  63.     #$6C, #$6C, #$6C, #$00, #$00, #$00, #$00, #$00, 
  64.     #$6C, #$6C, #$FE, #$6C, #$FE, #$6C, #$6C, #$00, 
  65.     #$30, #$7C, #$C0, #$78, #$0C, #$F8, #$30, #$00, 
  66.     #$00, #$C6, #$CC, #$18, #$30, #$66, #$C6, #$00, 
  67.     #$38, #$6C, #$38, #$76, #$DC, #$CC, #$76, #$00, 
  68.     #$60, #$60, #$C0, #$00, #$00, #$00, #$00, #$00, 
  69.     #$18, #$30, #$60, #$60, #$60, #$30, #$18, #$00, 
  70.     #$60, #$30, #$18, #$18, #$18, #$30, #$60, #$00, 
  71.     #$00, #$66, #$3C, #$FF, #$3C, #$66, #$00, #$00, 
  72.     #$00, #$30, #$30, #$FC, #$30, #$30, #$00, #$00, 
  73.     #$00, #$00, #$00, #$00, #$00, #$30, #$30, #$60, 
  74.     #$00, #$00, #$00, #$FC, #$00, #$00, #$00, #$00, 
  75.     #$00, #$00, #$00, #$00, #$00, #$30, #$30, #$00, 
  76.     #$06, #$0C, #$18, #$30, #$60, #$C0, #$80, #$00, 
  77.     #$7C, #$C6, #$CE, #$DE, #$F6, #$E6, #$7C, #$00, 
  78.     #$30, #$70, #$30, #$30, #$30, #$30, #$FC, #$00, 
  79.     #$78, #$CC, #$0C, #$38, #$60, #$CC, #$FC, #$00, 
  80.     #$78, #$CC, #$0C, #$38, #$0C, #$CC, #$78, #$00, 
  81.     #$1C, #$3C, #$6C, #$CC, #$FE, #$0C, #$1E, #$00, 
  82.     #$FC, #$C0, #$F8, #$0C, #$0C, #$CC, #$78, #$00, 
  83.     #$38, #$60, #$C0, #$F8, #$CC, #$CC, #$78, #$00, 
  84.     #$FC, #$CC, #$0C, #$18, #$30, #$30, #$30, #$00, 
  85.     #$78, #$CC, #$CC, #$78, #$CC, #$CC, #$78, #$00, 
  86.     #$78, #$CC, #$CC, #$7C, #$0C, #$18, #$70, #$00, 
  87.     #$00, #$30, #$30, #$00, #$00, #$30, #$30, #$00, 
  88.     #$00, #$30, #$30, #$00, #$00, #$30, #$30, #$60, 
  89.     #$18, #$30, #$60, #$C0, #$60, #$30, #$18, #$00, 
  90.     #$00, #$00, #$FC, #$00, #$00, #$FC, #$00, #$00, 
  91.     #$60, #$30, #$18, #$0C, #$18, #$30, #$60, #$00, 
  92.     #$78, #$CC, #$0C, #$18, #$30, #$00, #$30, #$00, 
  93.     #$7C, #$C6, #$DE, #$DE, #$DE, #$C0, #$78, #$00, 
  94.     #$30, #$78, #$CC, #$CC, #$FC, #$CC, #$CC, #$00, 
  95.     #$FC, #$66, #$66, #$7C, #$66, #$66, #$FC, #$00, 
  96.     #$3C, #$66, #$C0, #$C0, #$C0, #$66, #$3C, #$00, 
  97.     #$F8, #$6C, #$66, #$66, #$66, #$6C, #$F8, #$00, 
  98.     #$7E, #$60, #$60, #$78, #$60, #$60, #$7E, #$00, 
  99.     #$7E, #$60, #$60, #$78, #$60, #$60, #$60, #$00, 
  100.     #$3C, #$66, #$C0, #$C0, #$CE, #$66, #$3E, #$00, 
  101.     #$CC, #$CC, #$CC, #$FC, #$CC, #$CC, #$CC, #$00, 
  102.     #$78, #$30, #$30, #$30, #$30, #$30, #$78, #$00, 
  103.     #$1E, #$0C, #$0C, #$0C, #$CC, #$CC, #$78, #$00, 
  104.     #$E6, #$66, #$6C, #$78, #$6C, #$66, #$E6, #$00, 
  105.     #$60, #$60, #$60, #$60, #$60, #$60, #$7E, #$00, 
  106.     #$C6, #$EE, #$FE, #$FE, #$D6, #$C6, #$C6, #$00, 
  107.     #$C6, #$E6, #$F6, #$DE, #$CE, #$C6, #$C6, #$00, 
  108.     #$38, #$6C, #$C6, #$C6, #$C6, #$6C, #$38, #$00, 
  109.     #$FC, #$66, #$66, #$7C, #$60, #$60, #$F0, #$00, 
  110.     #$78, #$CC, #$CC, #$CC, #$DC, #$78, #$1C, #$00, 
  111.     #$FC, #$66, #$66, #$7C, #$6C, #$66, #$E6, #$00, 
  112.     #$78, #$CC, #$E0, #$70, #$1C, #$CC, #$78, #$00, 
  113.     #$FC, #$30, #$30, #$30, #$30, #$30, #$30, #$00, 
  114.     #$CC, #$CC, #$CC, #$CC, #$CC, #$CC, #$FC, #$00, 
  115.     #$CC, #$CC, #$CC, #$CC, #$CC, #$78, #$30, #$00, 
  116.     #$C6, #$C6, #$C6, #$D6, #$FE, #$EE, #$C6, #$00, 
  117.     #$C6, #$C6, #$6C, #$38, #$38, #$6C, #$C6, #$00, 
  118.     #$CC, #$CC, #$CC, #$78, #$30, #$30, #$78, #$00, 
  119.     #$FE, #$06, #$0C, #$18, #$30, #$60, #$FE, #$00, 
  120.     #$78, #$60, #$60, #$60, #$60, #$60, #$78, #$00, 
  121.     #$C0, #$60, #$30, #$18, #$0C, #$06, #$02, #$00, 
  122.     #$78, #$18, #$18, #$18, #$18, #$18, #$78, #$00, 
  123.     #$10, #$38, #$6C, #$C6, #$00, #$00, #$00, #$00, 
  124.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$FF, 
  125.     #$30, #$30, #$18, #$00, #$00, #$00, #$00, #$00, 
  126.     #$00, #$00, #$78, #$0C, #$7C, #$CC, #$76, #$00, 
  127.     #$E0, #$60, #$60, #$7C, #$66, #$66, #$DC, #$00, 
  128.     #$00, #$00, #$78, #$CC, #$C0, #$CC, #$78, #$00, 
  129.     #$1C, #$0C, #$0C, #$7C, #$CC, #$CC, #$76, #$00, 
  130.     #$00, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  131.     #$38, #$6C, #$60, #$F0, #$60, #$60, #$F0, #$00, 
  132.     #$00, #$00, #$76, #$CC, #$CC, #$7C, #$0C, #$F8, 
  133.     #$E0, #$60, #$6C, #$76, #$66, #$66, #$E6, #$00, 
  134.     #$30, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  135.     #$0C, #$00, #$0C, #$0C, #$0C, #$CC, #$CC, #$78, 
  136.     #$E0, #$60, #$66, #$6C, #$78, #$6C, #$E6, #$00, 
  137.     #$70, #$30, #$30, #$30, #$30, #$30, #$78, #$00, 
  138.     #$00, #$00, #$CC, #$FE, #$FE, #$D6, #$C6, #$00, 
  139.     #$00, #$00, #$F8, #$CC, #$CC, #$CC, #$CC, #$00, 
  140.     #$00, #$00, #$78, #$CC, #$CC, #$CC, #$78, #$00, 
  141.     #$00, #$00, #$DC, #$66, #$66, #$7C, #$60, #$F0, 
  142.     #$00, #$00, #$76, #$CC, #$CC, #$7C, #$0C, #$1E, 
  143.     #$00, #$00, #$DC, #$76, #$66, #$60, #$F0, #$00, 
  144.     #$00, #$00, #$7C, #$C0, #$78, #$0C, #$F8, #$00, 
  145.     #$10, #$30, #$7C, #$30, #$30, #$34, #$18, #$00, 
  146.     #$00, #$00, #$CC, #$CC, #$CC, #$CC, #$76, #$00, 
  147.     #$00, #$00, #$CC, #$CC, #$CC, #$78, #$30, #$00, 
  148.     #$00, #$00, #$C6, #$D6, #$FE, #$FE, #$6C, #$00, 
  149.     #$00, #$00, #$C6, #$6C, #$38, #$6C, #$C6, #$00, 
  150.     #$00, #$00, #$CC, #$CC, #$CC, #$7C, #$0C, #$F8, 
  151.     #$00, #$00, #$FC, #$98, #$30, #$64, #$FC, #$00, 
  152.     #$1C, #$30, #$30, #$E0, #$30, #$30, #$1C, #$00, 
  153.     #$18, #$18, #$18, #$00, #$18, #$18, #$18, #$00, 
  154.     #$E0, #$30, #$30, #$1C, #$30, #$30, #$E0, #$00, 
  155.     #$76, #$DC, #$00, #$00, #$00, #$00, #$00, #$00, 
  156.     #$00, #$10, #$38, #$6C, #$C6, #$C6, #$FE, #$00, 
  157.     #$78, #$CC, #$C0, #$CC, #$78, #$18, #$0C, #$78, 
  158.     #$00, #$CC, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  159.     #$1C, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  160.     #$7E, #$C3, #$3C, #$06, #$3E, #$66, #$3F, #$00, 
  161.     #$CC, #$00, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  162.     #$E0, #$00, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  163.     #$30, #$30, #$78, #$0C, #$7C, #$CC, #$7E, #$00, 
  164.     #$00, #$00, #$78, #$C0, #$C0, #$78, #$0C, #$38, 
  165.     #$7E, #$C3, #$3C, #$66, #$7E, #$60, #$3C, #$00, 
  166.     #$CC, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  167.     #$E0, #$00, #$78, #$CC, #$FC, #$C0, #$78, #$00, 
  168.     #$CC, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  169.     #$7C, #$C6, #$38, #$18, #$18, #$18, #$3C, #$00, 
  170.     #$E0, #$00, #$70, #$30, #$30, #$30, #$78, #$00, 
  171.     #$C6, #$38, #$6C, #$C6, #$FE, #$C6, #$C6, #$00, 
  172.     #$30, #$30, #$00, #$78, #$CC, #$FC, #$CC, #$00, 
  173.     #$1C, #$00, #$FC, #$60, #$78, #$60, #$FC, #$00, 
  174.     #$00, #$00, #$7F, #$0C, #$7F, #$CC, #$7F, #$00, 
  175.     #$3E, #$6C, #$CC, #$FE, #$CC, #$CC, #$CE, #$00, 
  176.     #$78, #$CC, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  177.     #$00, #$CC, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  178.     #$00, #$E0, #$00, #$78, #$CC, #$CC, #$78, #$00, 
  179.     #$78, #$CC, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  180.     #$00, #$E0, #$00, #$CC, #$CC, #$CC, #$7E, #$00, 
  181.     #$00, #$CC, #$00, #$CC, #$CC, #$7C, #$0C, #$F8, 
  182.     #$C3, #$18, #$3C, #$66, #$66, #$3C, #$18, #$00, 
  183.     #$CC, #$00, #$CC, #$CC, #$CC, #$CC, #$78, #$00, 
  184.     #$18, #$18, #$7E, #$C0, #$C0, #$7E, #$18, #$18, 
  185.     #$38, #$6C, #$64, #$F0, #$60, #$E6, #$FC, #$00, 
  186.     #$CC, #$CC, #$78, #$FC, #$30, #$FC, #$30, #$30, 
  187.     #$F8, #$CC, #$CC, #$FA, #$C6, #$CF, #$C6, #$C7, 
  188.     #$0E, #$1B, #$18, #$3C, #$18, #$18, #$D8, #$70, 
  189.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  190.     #$F0, #$F0, #$F0, #$F0, #$00, #$00, #$00, #$00, 
  191.     #$0F, #$0F, #$0F, #$0F, #$00, #$00, #$00, #$00, 
  192.     #$FF, #$FF, #$FF, #$FF, #$00, #$00, #$00, #$00, 
  193.     #$00, #$00, #$00, #$00, #$F0, #$F0, #$F0, #$F0, 
  194.     #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, 
  195.     #$0F, #$0F, #$0F, #$0F, #$F0, #$F0, #$F0, #$F0, 
  196.     #$FF, #$FF, #$FF, #$FF, #$F0, #$F0, #$F0, #$F0, 
  197.     #$00, #$00, #$00, #$00, #$0F, #$0F, #$0F, #$0F, 
  198.     #$F0, #$F0, #$F0, #$F0, #$0F, #$0F, #$0F, #$0F, 
  199.     #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, 
  200.     #$FF, #$FF, #$FF, #$FF, #$0F, #$0F, #$0F, #$0F, 
  201.     #$00, #$00, #$00, #$00, #$FF, #$FF, #$FF, #$FF, 
  202.     #$F0, #$F0, #$F0, #$F0, #$FF, #$FF, #$FF, #$FF, 
  203.     #$0F, #$0F, #$0F, #$0F, #$FF, #$FF, #$FF, #$FF, 
  204.     #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, 
  205.     #$22, #$88, #$22, #$88, #$22, #$88, #$22, #$88, 
  206.     #$55, #$AA, #$55, #$AA, #$55, #$AA, #$55, #$AA, 
  207.     #$DB, #$77, #$DB, #$EE, #$DB, #$77, #$DB, #$EE, 
  208.     #$18, #$18, #$18, #$18, #$18, #$18, #$18, #$18, 
  209.     #$18, #$18, #$18, #$18, #$F8, #$18, #$18, #$18, 
  210.     #$18, #$18, #$F8, #$18, #$F8, #$18, #$18, #$18, 
  211.     #$36, #$36, #$36, #$36, #$F6, #$36, #$36, #$36, 
  212.     #$00, #$00, #$00, #$00, #$FE, #$36, #$36, #$36, 
  213.     #$00, #$00, #$F8, #$18, #$F8, #$18, #$18, #$18, 
  214.     #$36, #$36, #$F6, #$06, #$F6, #$36, #$36, #$36, 
  215.     #$36, #$36, #$36, #$36, #$36, #$36, #$36, #$36, 
  216.     #$00, #$00, #$FE, #$06, #$F6, #$36, #$36, #$36, 
  217.     #$36, #$36, #$F6, #$06, #$FE, #$00, #$00, #$00, 
  218.     #$36, #$36, #$36, #$36, #$FE, #$00, #$00, #$00, 
  219.     #$18, #$18, #$F8, #$18, #$F8, #$00, #$00, #$00, 
  220.     #$00, #$00, #$00, #$00, #$F8, #$18, #$18, #$18, 
  221.     #$18, #$18, #$18, #$18, #$1F, #$00, #$00, #$00, 
  222.     #$18, #$18, #$18, #$18, #$FF, #$00, #$00, #$00, 
  223.     #$00, #$00, #$00, #$00, #$FF, #$18, #$18, #$18, 
  224.     #$18, #$18, #$18, #$18, #$1F, #$18, #$18, #$18, 
  225.     #$00, #$00, #$00, #$00, #$FF, #$00, #$00, #$00, 
  226.     #$18, #$18, #$18, #$18, #$FF, #$18, #$18, #$18, 
  227.     #$18, #$18, #$1F, #$18, #$1F, #$18, #$18, #$18, 
  228.     #$36, #$36, #$36, #$36, #$37, #$36, #$36, #$36, 
  229.     #$36, #$36, #$37, #$30, #$3F, #$00, #$00, #$00, 
  230.     #$00, #$00, #$3F, #$30, #$37, #$36, #$36, #$36, 
  231.     #$36, #$36, #$F7, #$00, #$FF, #$00, #$00, #$00, 
  232.     #$00, #$00, #$FF, #$00, #$F7, #$36, #$36, #$36, 
  233.     #$36, #$36, #$37, #$30, #$37, #$36, #$36, #$36, 
  234.     #$00, #$00, #$FF, #$00, #$FF, #$00, #$00, #$00, 
  235.     #$36, #$36, #$F7, #$00, #$F7, #$36, #$36, #$36, 
  236.     #$18, #$18, #$FF, #$00, #$FF, #$00, #$00, #$00, 
  237.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00, 
  238.     #$F0, #$F0, #$F0, #$F0, #$00, #$00, #$00, #$00, 
  239.     #$0F, #$0F, #$0F, #$0F, #$00, #$00, #$00, #$00, 
  240.     #$FF, #$FF, #$FF, #$FF, #$00, #$00, #$00, #$00, 
  241.     #$00, #$00, #$00, #$00, #$F0, #$F0, #$F0, #$F0, 
  242.     #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, #$F0, 
  243.     #$0F, #$0F, #$0F, #$0F, #$F0, #$F0, #$F0, #$F0, 
  244.     #$FF, #$FF, #$FF, #$FF, #$F0, #$F0, #$F0, #$F0, 
  245.     #$00, #$00, #$00, #$00, #$0F, #$0F, #$0F, #$0F, 
  246.     #$F0, #$F0, #$F0, #$F0, #$0F, #$0F, #$0F, #$0F, 
  247.     #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, #$0F, 
  248.     #$FF, #$FF, #$FF, #$FF, #$0F, #$0F, #$0F, #$0F, 
  249.     #$00, #$00, #$00, #$00, #$FF, #$FF, #$FF, #$FF, 
  250.     #$F0, #$F0, #$F0, #$F0, #$FF, #$FF, #$FF, #$FF, 
  251.     #$0F, #$0F, #$0F, #$0F, #$FF, #$FF, #$FF, #$FF, 
  252.     #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, #$FF, 
  253.     #$00, #$00, #$76, #$DC, #$C8, #$DC, #$76, #$00, 
  254.     #$00, #$78, #$CC, #$F8, #$CC, #$F8, #$C0, #$C0, 
  255.     #$00, #$FC, #$CC, #$C0, #$C0, #$C0, #$C0, #$00, 
  256.     #$00, #$FE, #$6C, #$6C, #$6C, #$6C, #$6C, #$00, 
  257.     #$FC, #$CC, #$60, #$30, #$60, #$CC, #$FC, #$00, 
  258.     #$00, #$00, #$7E, #$D8, #$D8, #$D8, #$70, #$00, 
  259.     #$00, #$66, #$66, #$66, #$66, #$7C, #$60, #$C0, 
  260.     #$00, #$76, #$DC, #$18, #$18, #$18, #$18, #$00, 
  261.     #$FC, #$30, #$78, #$CC, #$CC, #$78, #$30, #$FC, 
  262.     #$38, #$6C, #$C6, #$FE, #$C6, #$6C, #$38, #$00, 
  263.     #$38, #$6C, #$C6, #$C6, #$6C, #$6C, #$EE, #$00, 
  264.     #$1C, #$30, #$18, #$7C, #$CC, #$CC, #$78, #$00, 
  265.     #$00, #$00, #$7E, #$DB, #$DB, #$7E, #$00, #$00, 
  266.     #$06, #$0C, #$7E, #$DB, #$DB, #$7E, #$60, #$C0, 
  267.     #$38, #$60, #$C0, #$F8, #$C0, #$60, #$38, #$00, 
  268.     #$78, #$CC, #$CC, #$CC, #$CC, #$CC, #$CC, #$00, 
  269.     #$00, #$FC, #$00, #$FC, #$00, #$FC, #$00, #$00, 
  270.     #$30, #$30, #$FC, #$30, #$30, #$00, #$FC, #$00, 
  271.     #$60, #$30, #$18, #$30, #$60, #$00, #$FC, #$00, 
  272.     #$18, #$30, #$60, #$30, #$18, #$00, #$FC, #$00, 
  273.     #$0E, #$1B, #$1B, #$18, #$18, #$18, #$18, #$18, 
  274.     #$18, #$18, #$18, #$18, #$18, #$D8, #$D8, #$70, 
  275.     #$30, #$30, #$00, #$FC, #$00, #$30, #$30, #$00, 
  276.     #$00, #$76, #$DC, #$00, #$76, #$DC, #$00, #$00, 
  277.     #$38, #$6C, #$6C, #$38, #$00, #$00, #$00, #$00, 
  278.     #$00, #$00, #$00, #$18, #$18, #$00, #$00, #$00, 
  279.     #$00, #$00, #$00, #$00, #$18, #$00, #$00, #$00, 
  280.     #$0F, #$0C, #$0C, #$0C, #$EC, #$6C, #$3C, #$1C, 
  281.     #$78, #$6C, #$6C, #$6C, #$6C, #$00, #$00, #$00, 
  282.     #$70, #$18, #$30, #$60, #$78, #$00, #$00, #$00, 
  283.     #$00, #$00, #$3C, #$3C, #$3C, #$3C, #$00, #$00, 
  284.     #$00, #$00, #$00, #$00, #$00, #$00, #$00, #$00);
  285.  
  286.   _mul = 1024;
  287.   _mul2 = 512;
  288.   maxpoints = 50;
  289.  
  290.  
  291. obj_x = 0;
  292. obj_y = 0;
  293. obj_z : integer = 250;
  294. {$i 3d.inc}
  295.  
  296.  
  297. var
  298. yofs : array[0..200] of word;
  299. sini : array[0..249] of real;
  300. cosini : array[0..1000] of real;
  301. lines : array[0..maxpoints,0..1] of integer;
  302. points,rpoints : array[0..maxpoints,0..3] of integer;
  303.  
  304. procedure matriisi(var mat : t_matrix;kx2,ky2,kz2 : integer);
  305. var
  306. xa1,xa2,xa3,
  307. ya1,ya2,ya3,
  308. za1,za2,za3 : real;
  309. sinkz : real;
  310. begin
  311.   kx2 := kx2 mod 1000;
  312.   ky2 := ky2 mod 1000;
  313.   kz2 := kz2 mod 1000;
  314.   if kx2 < 0 then inc(kx2,1000);
  315.   if ky2 < 0 then inc(ky2,1000);
  316.   if kz2 < 0 then inc(kz2,1000);
  317.   sinkz := sini[kz2];
  318.   xa1 := cosini[KZ2]*cosini[KY2];
  319.   xa2 := -sinkz*cosini[KX2]-cosini[KZ2]*sini[KY2]*sini[KX2];
  320.   xa3 := sinkz*sini[KX2]-cosini[KZ2]*sini[KY2]*cosini[KX2];
  321.   ya1 := sinkz*cosini[KY2];
  322.   ya2 := cosini[KZ2]*cosini[KX2]-sinkz*sini[KY2]*sini[KX2];
  323.   ya3 := -sinkz*sini[KY2]*cosini[KX2]-cosini[KZ2]*sini[KX2];
  324.   za1 := sini[KY2];
  325.   za2 := cosini[KY2]*sini[KX2];
  326.   za3 := cosini[KY2]*cosini[KX2];
  327.   mat[0] := round(xa1*_mul);
  328.   mat[1] := round(xa2*_mul);
  329.   mat[2] := round(xa3*_mul);
  330.   mat[3] := round(ya1*_mul);
  331.   mat[4] := round(ya2*_mul);
  332.   mat[5] := round(ya3*_mul);
  333.   mat[6] := round(za1*_mul);
  334.   mat[7] := round(za2*_mul);
  335.   mat[8] := round(za3*_mul);
  336. end;
  337.  
  338. procedure rotatep;
  339. var
  340. ax_,ay,az : longint;
  341. x,y,z : longint;
  342. rx,ry : integer;
  343. n,col : integer;
  344. maxp : integer;
  345. begin
  346.   maxp := points[0,0];
  347.   for n := 1 to maxp do begin
  348.     x := points[n,0];
  349.     y := points[n,1];
  350.     z := points[n,2];
  351.     asm
  352.       mov  ax,word ptr x
  353.       imul word ptr matrix[0]
  354.       mov  cx,dx
  355.       mov  bx,ax
  356.       xor  dx,dx
  357.       mov  ax,word ptr y
  358.       imul word ptr matrix[4]
  359.       add  bx,ax
  360.       adc  cx,dx
  361.       mov  ax,word ptr z
  362.       imul word ptr matrix[8]
  363.       add  ax,bx
  364.       adc  dx,cx
  365.       shl  dx,6
  366.       shr  ax,10
  367.       add  ax,dx
  368.  
  369.       add  ax,obj_x
  370.       cwd
  371.       mov  word ptr ax_,ax
  372.       mov  word ptr ax_+2,dx
  373.  
  374.       mov  ax,word ptr x
  375.       imul word ptr matrix[12]
  376.       mov  cx,dx
  377.       mov  bx,ax
  378.       xor  dx,dx
  379.       mov  ax,word ptr y
  380.       imul word ptr matrix[16]
  381.       add  bx,ax
  382.       adc  cx,dx
  383.       mov  ax,word ptr z
  384.       imul word ptr matrix[20]
  385.       add  ax,bx
  386.       adc  dx,cx
  387.       shl  dx,6
  388.       shr  ax,10
  389.       add  ax,dx
  390.  
  391.       add  ax,obj_y
  392.       cwd
  393.       mov  word ptr ay,ax
  394.       mov  word ptr ay+2,dx
  395.  
  396.       mov  ax,word ptr x
  397.       imul word ptr matrix[24]
  398.       mov  cx,dx
  399.       mov  bx,ax
  400.       xor  dx,dx
  401.       mov  ax,word ptr y
  402.       imul word ptr matrix[28]
  403.       add  bx,ax
  404.       adc  cx,dx
  405.       mov  ax,word ptr z
  406.       imul word ptr matrix[32]
  407.       add  ax,bx
  408.       adc  dx,cx
  409.       shl  dx,6
  410.       shr  ax,10
  411.       add  ax,dx
  412.  
  413.       add  ax,obj_z
  414.       cwd
  415.       mov  word ptr az,ax
  416.       mov  word ptr az+2,dx
  417.     end;
  418.     {ax_:= (x*matrix[0] +
  419.            y*matrix[1] +
  420.            z*matrix[2]) div _mul;
  421.     ay:= (x*matrix[3]+
  422.                y*matrix[4]+
  423.                z*matrix[5]) div _mul;
  424.     az:= obj_z+(x*matrix[6]+
  425.                y*matrix[7]+
  426.                z*matrix[8]) div _mul;
  427.     rpoints[n,0] := 160+200*longint(ax_) div longint(az);
  428.     rpoints[n,1] := 100+166*longint(ay) div longint(az);
  429.     rpoints[n,2] := az;}
  430.     asm
  431.       mov  bx,n
  432.       shl  bx,3
  433.       mov  cx,word ptr az
  434.       mov  ax,120
  435.       imul word ptr ax_
  436.       idiv cx
  437.       add  ax,80
  438.       mov  word ptr rx,ax
  439.       mov  ax,100
  440.       imul word ptr ay
  441.       idiv cx
  442.       add  ax,50
  443.       mov  word ptr ry,ax
  444.       mov  [bx+offset rpoints+2],ax
  445.       mov  ax,word ptr rx
  446.       mov  [bx+offset rpoints],ax
  447.     end;
  448.   end;
  449. end;
  450.  
  451. procedure init3d;
  452. var
  453. n : integer;
  454. begin
  455.   for n := 0 to 249 do sini[n] := sin(n*pi/500);
  456.   for n := 0 to 1000 do begin
  457.     cosini[n] := cos(n*pi/500);
  458.   end;
  459.   fillchar(points,sizeof(points),0);
  460.   fillchar(rpoints,sizeof(rpoints),0);
  461.   for n := 0 to 100 do yofs[n] := n*160;
  462. end;
  463.  
  464. procedure xline3(d,_dx,incr1,incr2,yinc,address:word;color:byte); assembler;
  465. { draw line with X as the independent variable
  466.  
  467.   d        decision variable
  468.   _dx       number of pixels in x-dimension of line
  469.   incr1    increment #1 value for decision variable
  470.   incr2    increment #2 value for decision variable
  471.   yinc     amount to add to y variable / point
  472.   address  starting offset address into display memory
  473.   color    desired color}
  474. asm
  475.   push ds
  476.   mov  ds,scr_seg
  477.  
  478. { load the working registers with the variables}
  479.   mov  di,address
  480.   mov  cx,_dx  {number of points -> cx}
  481.   mov  bx,d   {decision variable -> bx}
  482.   mov  al,color
  483.  
  484. {operational loop}
  485. @@runloop:
  486.                    {send the first point}
  487.   mov  [di],al  {write to display memory}
  488.  
  489.   inc  di          {increment x variable}
  490.  
  491.   cmp  bx,0        {d = 0 ?}
  492.   jl   @@noinc     {jump if d < 0}
  493.  
  494.                    {adjust d += incr2 + increment y += inc}
  495.   add  bx,incr2    {d = d+incr2}
  496.  
  497.   add  di,yinc     {y (address) += offset}
  498.   {jmp  @@check}
  499.                    {adjust d += incr1}
  500. @@noinc:
  501.   add  bx,incr1    {d = d+incr1}
  502.  
  503. @@check:
  504.   dec  cx
  505.   jnz  @@runloop
  506.   pop  ds
  507. end;
  508.  
  509. procedure yline3(d,dy,incr1,incr2,xinc,address,ofset:word;color:byte);
  510. assembler;
  511. {draw a line with Y as the independent variable
  512.  
  513. d       decision variable
  514. dy      # of pixels in y-dimension of line
  515. incr1   increment #1 value for decision variable
  516. incr2   increment #2 value for decision variable
  517. xinc    amount to add to x variable / point
  518. address starting offset adress of display memory
  519. ofset  display offset}
  520.  
  521. asm
  522.   push ds
  523.   mov  ds,scr_seg
  524.                      {load working registers with the variables}
  525.   mov  di,address    {load display offset address}
  526.   mov  cx,dy         {# of points -> cx}
  527.   mov  bx,d          {decision variable -> bx}
  528.   mov  ah,color
  529.  
  530. @@runloop:
  531.   mov  [di],ah    {write to display memory}
  532.  
  533.   add  di,160     {y (address) += offset (always positive)}
  534.  
  535.   cmp  bx,0          {d = 0 ?}
  536.   jl   @@noinc       {jump if d < 0}
  537.  
  538.   add  bx,incr2      {d = d+incr2}
  539.  
  540.   add  di,xinc       {inc x variable}
  541.   {jmp  @@check}
  542.  
  543. @@noinc:
  544.   add  bx,incr1      {d = d+incr1}
  545.  
  546. @@check:
  547.   dec  cx
  548.   jnz  @@runloop
  549.   pop  ds
  550. end;
  551.  
  552. procedure hline3(x1,x2,y,offset : word;color : byte);
  553. var
  554.   x,dx,address : integer;
  555.  
  556. procedure hsub3(address,_dx : word;color:byte); assembler;
  557. asm
  558.   cld
  559.   mov  es,scr_seg
  560.   mov  di,address
  561.   mov  cx,_dx
  562.   mov  al,color
  563.   rep  stosb
  564. end;
  565.  
  566. begin
  567.   if (y < 0) or (y > 99) then exit;
  568.   if x1 > x2 then begin
  569.     x := x1; x1 := x2; x2:= x;  {reverse x-coordinates}
  570.   end;
  571.   if (x1 > 159) or (x2 < 0) then exit;
  572.   if x1 < 0 then x1 := 0;
  573.   if x2 > 159 then x2 := 159;
  574.   {dx := (x2-x1)+1;
  575.   address := (y*offset)+x1;
  576.   hsub3(address,dx,color);}
  577.   asm
  578.     mov  cx,x2
  579.     sub  cx,x1
  580.     inc  cx
  581.     mov  di,y
  582.     add  di,di
  583.     mov  di,[di+offset yofs]
  584.     add  di,x1
  585.     mov  es,scr_seg
  586.     mov  al,color
  587.     rep  stosb
  588.   end;
  589. end;
  590.  
  591. procedure vline3(x,y1,y2,ofset : integer;color : byte);
  592. var
  593.   t,dy,address : integer;
  594.  
  595. procedure vsub3(address,dy,ofset : word;color : byte); assembler;
  596. asm
  597.   mov  es,scr_seg
  598.   mov  di,address
  599.   mov  cx,dy
  600.   mov  al,color
  601. @@runloop:
  602.   mov  es:[di],al
  603.   add  di,ofset
  604.   dec  cx
  605.   jnz  @@runloop
  606. end;
  607.  
  608. begin
  609.   if (x < 0) or (x > 159) then exit;
  610.   if y1 > y2 then begin
  611.     t := y2; y2 := y1; y1 := t;
  612.   end;
  613.   if (y1 > 99) or (y2 < 0) then exit;
  614.   if y1 < 0 then y1 := 0;
  615.   if y2 > 99 then y2 := 99;
  616.   {dy := y2-y1+1;}
  617.   asm
  618.     mov  es,scr_seg
  619.     mov  cx,y2
  620.     sub  cx,y1
  621.     inc  cx
  622.     mov  bx,y1
  623.     add  bx,bx
  624.     mov  di,[bx+offset yofs]
  625.     add  di,x
  626.     mov  al,color
  627. @@runloop:
  628.     mov  es:[di],al
  629.     add  di,160
  630.     dec  cx
  631.     jnz  @@runloop
  632.   end;
  633.   {vsub3(address,dy,offset,color);}
  634. end;
  635.  
  636. procedure line3(x1,y1,x2,y2 : integer;color : byte);
  637. const
  638.   offset : integer = 160;
  639. var
  640.   dx,dy,d,d2,xinc,yinc,incr1,incr2,x,y,address : integer;
  641. begin
  642.   if y1 > y2 then begin
  643.     d := x1;
  644.     x1 := x2;
  645.     x2 := d;
  646.     d := y1;
  647.     y1 := y2;
  648.     y2 := d;
  649.   end;
  650.   dx := abs(x2-x1);  {x-length}
  651.   if dx = 0 then vline3(x1,y1,y2,offset,color)
  652.   else begin
  653.     dy := abs(y2-y1);
  654.     if dy = 0 then hline3(x1,x2,y1,offset,color)
  655.     else begin    {neither horz or vert then do bresenhams}
  656.                  {is the slope between 0 and 1 ie. dy > dx}
  657.       if dx >= dy then begin     {slope < 1 quadrants 0,1,2 or 3}
  658.         if x1 > x2 then begin    {quadrant 0 or 1}
  659.           x := x2; y := y2;
  660.           if y2 > y1 then yinc := -offset  {quadrant 0}
  661.           else yinc := offset;             {quadrant 1}
  662.         end
  663.         else begin
  664.           x := x1; y := y1;
  665.           if y2 > y1 then yinc := offset   {quadrant 2}
  666.           else yinc := -offset;            {quadrant 3}
  667.         end;
  668.         address := y*offset+x;      {starting address}
  669.         d2 := dy shl 1;             {y distance times 2}
  670.         d := d2-dx;     {init the decision variable to 2*dy-dx}
  671.         incr1 := d2;        {incr. for decision var. if d < 0}
  672.         incr2 := (dy-dx) shl 1-incr1;  {incr. for decision var if d >= 0}
  673.         xline3(d,dx+1,incr1,incr2,yinc,address,color);
  674.       end
  675.       else begin     {slope > 1 quadrant 4, 5, 6 or 7}
  676.         if y1 > y2 then begin   {quadrant 4 or 5}
  677.           x := x2; y := y2;
  678.           if x > x1 then xinc := -1  {quadrant 4}
  679.           else xinc := 1;            {quadrant 5}
  680.         end
  681.         else begin
  682.           x := x1; y := y1;   {quadrant 6 or 7}
  683.           if x2 > x1 then xinc := 1    {quadrant 6}
  684.           else xinc := -1;             {quadrant 7}
  685.         end;
  686.         address := y*offset+x;
  687.         d2 := dx shl 1;         {x distance times 2}
  688.         d := d2-dy;             {decision var. = 2*dx-dy}
  689.         incr1 := d2;            {incr. for decision var, d' if d <0}
  690.         incr2 := (dx-dy) shl 1-incr1; {incr. for decision var if d >= 0}
  691.         yline3(d,dy+1,incr1,incr2,xinc,address,offset,color);
  692.       end;         {end of quadrants 0,1,2,3 or 4,5,6,7}
  693.     end;
  694.   end;
  695. end;
  696.  
  697. procedure mix; assembler;
  698. asm
  699.   push ds
  700.   mov  ds,scr_seg
  701.   mov  si,0
  702.   mov  ax,0b800h
  703.   mov  es,ax
  704.   mov  di,0
  705.   mov  dx,49
  706. @@y:
  707.   mov  cx,80
  708. @@x:
  709.   mov  ah,[si+1]
  710.   add  ah,ah
  711.   add  ah,[si]
  712.   mov  al,[si+160]
  713.   shl  al,2
  714.   add  ah,al
  715.   mov  al,[si+161]
  716.   shl  al,3
  717.   add  ah,al
  718.   add  ah,208
  719.   mov  es:[di],ah
  720.   add  si,2
  721.   add  di,2
  722.   dec  cx
  723.   jnz  @@x
  724.   add  si,160
  725.   dec  dx
  726.   jnz  @@y
  727.   pop  ds
  728. end;
  729.  
  730. procedure show;
  731. var
  732. n : integer;
  733. p1,p2 : integer;
  734. begin
  735.   for n := 1 to lines[0,0] do begin
  736.     p1 := lines[n,0];
  737.     p2 := lines[n,1];
  738.     line3(rpoints[p1,0],rpoints[p1,1],
  739.           rpoints[p2,0],rpoints[p2,1],1);
  740.   end;
  741. end;
  742.  
  743. procedure hide; assembler;
  744. asm
  745.   cld
  746.   xor  ax,ax
  747.   mov  cx,160*100/2
  748.   mov  es,scr_seg
  749.   mov  di,0
  750.   rep  stosw
  751. end;
  752.  
  753. procedure setfont; assembler;
  754. asm
  755.   push bp
  756.   mov  ax,seg fontti
  757.   mov  es,ax
  758.   mov  bp,offset fontti
  759.   mov  bx,$800
  760.   mov  dx,0
  761.   mov  cx,256
  762.   mov  ax,$1110
  763.   int  10h
  764.   pop  bp
  765. end;
  766.  
  767. procedure l3d_cube;
  768. begin
  769.   move(cubep,points,sizeof(cubep));
  770.   move(cubel,lines,sizeof(cubel));
  771.   obj_z := points[0,1];
  772. end;
  773.  
  774. procedure l3d_pyramid;
  775. begin
  776.   move(pyramidp,points,sizeof(cubep));
  777.   move(pyramidl,lines,sizeof(cubel));
  778.   obj_z := points[0,1];
  779. end;
  780.  
  781. procedure l3d_adnmod;
  782. begin
  783.   move(adnmodp,points,sizeof(adnmodp));
  784.   move(adnmodl,lines,sizeof(adnmodl));
  785.   obj_z := points[0,1];
  786. end;
  787.  
  788. end.
  789.